Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/1138/source.zip/FRMEXTED.FRM

Text File | 1995-03-07 | 8KB | 254 lines

VERSION 2.00
Begin Form frmexted
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "External Editor"
   ClientHeight    =   2208
   ClientLeft      =   1308
   ClientTop       =   2268
   ClientWidth     =   3924
   ClipControls    =   0   'False
   Height          =   2628
   Left            =   1260
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2208
   ScaleWidth      =   3924
   Top             =   1896
   Width           =   4020
   Begin CommandButton cmdabort
      Cancel          =   -1  'True
      Caption         =   "&Abort"
      Default         =   -1  'True
      Height          =   372
      Left            =   2160
      TabIndex        =   1
      Top             =   1560
      Width           =   972
   End
   Begin CommandButton cmdsend
      Caption         =   "&Send"
      Enabled         =   0   'False
      Height          =   372
      Left            =   600
      TabIndex        =   0
      Top             =   1560
      Width           =   972
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Height          =   852
      Left            =   720
      TabIndex        =   2
      Top             =   240
      Width           =   2292
      WordWrap        =   -1  'True
   End
End
Option Explicit
Dim fname As String
Dim linecount As Integer
Dim flen As Long

Sub cmdabort_Click ()
Dim result As Integer

    result = MsgBox("You will lose any text you entered." + Chr(10) + "Are you sure?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2, "Abort message " + fname + "?")
    If result = IDYES Then
        Kill fname
        Unload frmexted
    End If
End Sub

Sub cmdsend_Click ()
Dim result As Integer
Dim foldername As String
Dim newfname As String

    If FileLen(fname) = flen Then
        result = MsgBox("Are you sure you saved the file?", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2, "File size unchanged")
        If result = IDNO Then Exit Sub
    End If

    ' Copy message to posted folder
    foldername = GetINI("Folders", "CreatedTo", "Sent Messages")
    Call CreateFolder(foldername)
    SaveFiletoFolder fname, foldername

    ' Change from .TMP to .MSG and Post it as SOUP replies packet
    newfname = Mid$(fname$, 1, Len(fname$) - 3) + "MSG"
    Name fname As newfname
    result = Post(newfname, replytype) 'post mail or news

    Unload frmexted
End Sub

Function CreateMessage () As Integer
Dim uniq As Integer, result As Integer
Dim fout As Integer
Dim sigout As Integer
Dim sigline As String
Dim sigfname As String
Dim ptr, column As Integer
Dim replyto, organization As String
Dim refer As String

    ' Do headers
    refer = ""
    If mailsendto = "" Then mailsendto = InputBox$("Who is this message to?", "New Message", "")
    If mailsendto = "" Then
        CreateMessage = 1
        Exit Function
    End If
    If mailsubject = "" Then mailsubject = InputBox$("What is this message's Subject?", "New Message", "")
    If mailsubject = "" Then
        CreateMessage = 1
        Exit Function
    End If

    ChDrive App.Path
    ChDir App.Path

    ' Get a unique filename (PBR00N.MSG)
    uniq = Val(GetINI("Message", "LastMessage", "1"))
    uniq = uniq + 1
    SetINI "Message", "LastMessage", Format$(uniq)
    If replytype = 1 Then
        fname = App.Path + "\PBM" + Format$(uniq, "000") + ".TMP"
    Else
        fname = App.Path + "\PBN" + Format$(uniq, "000") + ".TMP"
    End If

    fout = FreeFile
    Open fname For Output As fout
    linecount = 0

    If replytype = 1 Then
        Print #fout, "To: " + mailsendto
        linecount = linecount + 1
        If mailreferences <> "" Then
            Print #fout, "References: " + mailreferences
            linecount = linecount + 1
            refer = "In article " + fixstr(GetHeader("Message-ID")) + ", you wrote:"
        End If
    Else
        Print #fout, "Newsgroups: " + mailsendto
        linecount = linecount + 1
        If mailreferences <> "" Then
            Print #fout, "References: " + mailreferences
            linecount = linecount + 1
            refer = "In article " + fixstr(GetHeader("Message-ID")) + ", " + fixstr(GetHeader("From")) + " wrote:"
        End If
    End If
    Print #fout, "Subject: " + mailsubject
    linecount = linecount + 1
    If UCase$(GetINI("Message", "PostDate", "N")) = "Y" Then
        Print #fout, "Date: " + fixstr(GetGMTime())
        linecount = linecount + 1
    End If

' Optional Reply-To
    replyto = GetINI("Message", "Reply-To", "")
    If Len(replyto) > 2 Then
        Print #fout, "Reply-To: " + replyto
        linecount = linecount + 1
    End If

' Optional Organization
    organization = GetINI("Message", "Organization", "")
    If Len(organization) > 2 Then
        Print #fout, "Organization: " + organization
        linecount = linecount + 1
    End If

    Print #fout,  ' Blank line seperates headers from message
    linecount = linecount + 1

    If mailreferences <> "" Then
    ' It's a reply, quote previous message
        Print #fout, refer
        linecount = linecount + 1
        For ptr = endofheaders() To GetNumLines()
            Print #fout, ">"; fixstr(GetLine(ptr))
            linecount = linecount + 1
            If linecount > Val(GetINI("Editor", "MaxLinesQuote", "100")) Then
                Print #fout, "> ... (Message Truncated)"
                MsgBox "Too many lines to quote (" + Format$(linecount) + ")", MB_ICONEXCLAMATION, "Truncated"
                Exit For
            End If
        Next ptr
        Print #fout, 'Blank line after quote
        linecount = linecount + 1
    End If

    Print #fout,

    ' Do signature
    sigfname = GetINI("Message", "Signature-File", App.Path + "\SIG.TXT")
    If FileExists(sigfname) Then
        sigout = FreeFile
        Open sigfname For Input As sigout
        Print #fout, "-- "  ' Begin signature signature
        While Not EOF(sigout)
            Line Input #sigout, sigline
            Print #fout, sigline
        Wend
        Close sigout
        Else
            ' Default signature ?
    End If
    Close fout
    CreateMessage = 0
End Function

Sub Form_Activate ()
Dim x As Integer
Dim z As Integer
Dim editor As String
Dim result As Integer

    result = CreateMessage()
    If result = 1 Then
        Unload frmexted
        Exit Sub
    End If

    flen = FileLen(fname)

    Label1.Caption = "Please edit and save the file " + fname
    editor = GetINI("Editor", "ExternalEditor", "notepad.exe")
    editor = editor + " " + fname

    x = Shell(editor, 3)
    ' Skip down to right before the signatures
    For z = 1 To linecount
        SendKeys "{DOWN}"
    Next z

    'While FileLen(fname) = flen
    '    z = DoEvents()
    'Wend
    'While GetModuleUsage(x) > 0
    '    z = DoEvents()
    'Wend
    cmdsend.Enabled = True
    cmdsend.Default = True
    cmdabort.Default = False
    'Label1.Caption = "Send message " + fname + "?"

End Sub

Sub Form_Load ()
Dim x As Integer
Dim z As Integer
Dim editor As String

    frmexted.Left = (screen.Width - frmexted.Width) / 2
    frmexted.Top = (screen.Height - frmexted.Height) / 2
    cmdsend.Enabled = False
End Sub